#!/usr/bin/perl -w

use strict;

use App::Options (
    options => [qw(dbdriver dbclass dbhost dbname dbuser dbpass)],
    option => {
        dbclass  => { default => "App::Repository::MySQL", },
        dbdriver => { default => "mysql", },
        dbhost   => { default => "localhost", },
        dbname   => { default => "test", },
        dbuser   => { default => "", },
        dbpass   => { default => "", },
    },
);

use Test::More qw(no_plan);
use lib "../App-Context/lib";
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
use lib ".";
use lib "t";

use App;

my ($context);

$context = App->context(
    conf_file => "",
    sessionobject_class => $App::options{sessionobject_class},
);

sub verify_session_object {
    my ($obj, $name, $stateless, $anonymous, $lang) = @_;
    my $obj_name = $obj->{name};
    if (!$obj_name) {
        ok($obj_name, "object has a name [$obj_name]");
    }
    else {
        is($obj->get("context"),   $context,   "[$name]->{context}   [$context] is set (accessible with get())");
        is($obj->context,          $context,   "[$name]->{context}   [$context] is set (accessible with accessor)");
        is($obj->{context},        $context,   "[$name]->{context}   [$context] is set (accessible directly)");
        is($obj->get("name"),      $name,      "[$name]->{name}      [$name] is set (accessible with get())");
        is($obj->name,             $name,      "[$name]->{name}      [$name] is set (accessible with accessor)");
        is($obj->{name},           $name,      "[$name]->{name}      [$name] is set (accessible directly)");
        is($obj->get("stateless"), $stateless, "[$name]->{stateless} [$stateless] is set (accessible with get())");
        is($obj->stateless,        $stateless, "[$name]->{stateless} [$stateless] is set (accessible with accessor)");
        is($obj->{stateless},      $stateless, "[$name]->{stateless} [$stateless] is set (accessible directly)");
        is($obj->get("anonymous"), $anonymous, "[$name]->{anonymous} [$anonymous] is set (accessible with get())");
        is($obj->anonymous,        $anonymous, "[$name]->{anonymous} [$anonymous] is set (accessible with accessor)");
        is($obj->{anonymous},      $anonymous, "[$name]->{anonymous} [$anonymous] is set (accessible directly)");
        is($obj->get("lang"),      $lang,      "[$name]->{lang}      [$lang] is set (accessible with get())");
        is($obj->lang,             $lang,      "[$name]->{lang}      [$lang] is set (accessible with accessor)");
        is($obj->{lang},           $lang,      "[$name]->{lang}      [$lang] is set (accessible directly)");
    }
}

{
    my $session_object = $context->service("SessionObject");

    my $options       = $context->{options};
    my $session_store = $context->{session}{store};
    my $session_cache = $context->{session}{cache};

    ok(defined $session_object, "[default] constructor ok");
    isa_ok($session_object, "App::Moose::SessionObject", "[default] right class");
    is($session_object->service_type(), "SessionObject", "[default] right service type");
    my $dump = $session_object->dump(1);
    ok($dump =~ /^\$VAR1 = bless.*App::Moose::SessionObject/s, "dump formatted ok");   # NOTE: a Moose dump() is a slightly different format from an App::Service dump()
    #print STDERR $dump;
    &verify_session_object($session_object, "default", 0, 0, "en");

    is($session_cache->{SessionObject}{default}, $session_object, "Object is stored in the session cache [$session_cache->{SessionObject}{default} = $session_object]");
    my $so2 = $context->session_object();
    is($so2, $session_object, "Second attempt gets the same object [$so2 = $session_object]");

    $so2->set("foo","bar");
    is($session_object->get("foo"), "bar", "Got value on one object which was set on another");
    is($context->so_get("foo"), "bar", "Got same value from the Context");
    # NOTE: The following two cases are INTERNAL (not part of the published API)
    is($session_cache->{SessionObject}{default}{foo}, "bar", "Got same value from the internal cache of the Context");
    is($session_store->{SessionObject}{default}{foo}, "bar", "Got same value from the internal store of the Context");

    my ($foo2);
    $so2->set("{foo2}{subfoo}","bar");
    is($session_object->get("{foo2}{subfoo}"), "bar", "Got deep value on one object which was set on another");
    $foo2 = $session_object->get("foo2");
    is($foo2->{subfoo}, "bar", "Got same deep value from the object in two steps");
    is($context->so_get("{foo2}{subfoo}"), "bar", "Got same deep value from the Context");
    is($context->so_get("default", "{foo2}{subfoo}"), "bar", "Got same deep value from the Context (using name and attribute)");
    $foo2 = $context->so_get("foo2");
    is($foo2->{subfoo}, "bar", "Got same deep value from the Context in two steps");
    # NOTE: The following two cases are INTERNAL (not part of the published API)
    is($session_cache->{SessionObject}{default}{foo2}{subfoo}, "bar", "Got same deep value from the internal cache of the Context");
    is($session_store->{SessionObject}{default}{foo2}{subfoo}, "bar", "Got same deep value from the internal store of the Context");

    # An anonymous SessionObject for a name that already exists
    my $so_anon = $context->session_object("default", anonymous => 1, lang => "fr");
    ok($so_anon ne $so2, "Anonymous default SessionObject [$so_anon] differs from Stateful default SessionObject [$so2]");
    &verify_session_object($so_anon, "default", 1, 1, "fr");
    &verify_session_object($session_object, "default", 0, 0, "en");

    # An anonymous SessionObject for a name that does not already exist
    $so_anon = $context->session_object("anon", anonymous => 1);
    &verify_session_object($so_anon, "anon", 1, 1, "en");
    # NOTE: The following two cases are INTERNAL (not part of the published API)
    is($session_cache->{SessionObject}{anon}, undef, "Anonymous SessionObject does not affect the internal cache of the Context");
    is($session_store->{SessionObject}{anon}, undef, "Anonymous SessionObject does not affect the internal store of the Context");
    $so_anon->set("foo", "baz");
    is($so_anon->{foo}, "baz", "Anonymous SessionObject set() works");
    is($so_anon->get("foo"), "baz", "Anonymous SessionObject get() works");
    is($session_cache->{SessionObject}{anon}, undef, "Anonymous SessionObject still does not affect the internal cache of the Context");
    is($session_store->{SessionObject}{anon}, undef, "Anonymous SessionObject still does not affect the internal store of the Context");

    # Another anonymous SessionObject for a name that does not already exist
    my $so_anon2 = $context->session_object("anon", anonymous => 1);
    &verify_session_object($so_anon2, "anon", 1, 1, "en");
    ok($so_anon2 ne $so_anon, "Anonymous SessionObject [$so_anon2] differs from earlier Anonymous SessionObject [$so_anon]");

    # A stateless SessionObject
    my $so_stateless = $context->session_object("state_less", stateless => 1, foo => "bar");
    &verify_session_object($so_stateless, "state_less", 1, 0, "en");
    # NOTE: The following two cases are INTERNAL (not part of the published API)
    is($session_cache->{SessionObject}{state_less}, $so_stateless, "Stateless SessionObject does affect the internal cache of the Context");
    is($session_store->{SessionObject}{state_less}, undef, "Stateless SessionObject does not affect the internal store of the Context");
    is($so_stateless->{foo}, "bar", "Stateless SessionObject retains unexpected initializers");
    $so_stateless->set("foo", "baz");
    is($so_stateless->{foo}, "baz", "Stateless SessionObject set() works");
    is($so_stateless->get("foo"), "baz", "Stateless SessionObject get() works");
    is($session_cache->{SessionObject}{state_less}{foo}, "baz", "Stateless SessionObject still does affect the internal cache of the Context");
    is($session_store->{SessionObject}{state_less}, undef, "Stateless SessionObject still does not affect the internal store of the Context");
}

exit 0;

